home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / pascal / psgui130.zip / PGUIAPP.PAS < prev    next >
Pascal/Delphi Source File  |  1993-01-01  |  13KB  |  416 lines
  1. {
  2.  
  3.                                                       ╔══════════════════╗
  4.                                                       ║  PGUI Graphic    ║
  5.                                                       ║  App. Include    ║
  6.                                                       ║    Rev.  1.00    ║
  7.                                                       ╚══════════════════╝
  8.  
  9. }
  10.  
  11. Procedure InitVGA(VPath:String);
  12.  
  13. { ╔════════════════════════════════════════════════════════════════════════╗ }
  14. { ║   Setup VGA Mode using BGI driver in path VPath.                       ║ }
  15. { ╚════════════════════════════════════════════════════════════════════════╝ }
  16.  
  17. Var
  18.   Mode:Integer;
  19.   Driver:Integer;
  20.  
  21. Begin
  22.   Driver := VGA;
  23.   Mode := VGAHi;
  24.   InitGraph( Driver, Mode, VPath);
  25. End;
  26.  
  27. Procedure StandardScreen(Title:String);
  28.  
  29. { ╔════════════════════════════════════════════════════════════════════════╗ }
  30. { ║  Clears the screen and displays the header.                            ║ }
  31. { ╚════════════════════════════════════════════════════════════════════════╝ }
  32.  
  33. Begin
  34.   Mouse.Hide;
  35.   ClearDevice;
  36.   SetFillStyle(SolidFill,1);
  37.   Bar(0, 0, 639, 16);
  38.   SetColor(White);
  39.   SetBkColor(Black);
  40.   ShadeText(4, 4, Title);
  41.   Mouse.Show;
  42. End;
  43.  
  44. Procedure Box(X1,Y1,X2,Y2:Word;C1,C2,Thick:Byte);
  45. {Co-Ords,Box,Shadow,Box Thickness}
  46.  
  47. { ╔════════════════════════════════════════════════════════════════════════╗ }
  48. { ║  Draws a graphic box, coordinates X1,Y1 to X2,Y2, using the colours    ║ }
  49. { ║  C1 and C2.                                                            ║ }
  50. { ║                                                                        ║ }
  51. { ║  The box thickness is set by Thick and the box has a shadow.           ║ }
  52. { ║  The shadow is always 1 in thickness, deactivated by C2 = Background.  ║ }
  53. { ╚════════════════════════════════════════════════════════════════════════╝ }
  54.  
  55. Var
  56.   I      :Byte;
  57.   OldClr :Word;
  58.  
  59. Begin
  60.   OldClr:=GetColor;
  61.   SetColor(C2);
  62.   Line(X2+1,Y1+5,X2+1,Y2+1);
  63.   Line(X1+4,Y2+1,X2+1,Y2+1);
  64.   SetColor(C1);
  65.   For I:=1 to Thick do
  66.   Begin
  67.     Line(X1,Y1,X2,Y1);
  68.     Line(X2,Y1,X2,Y2);
  69.     Line(X2,Y2,X1,Y2);
  70.     Line(X1,Y2,X1,Y1);
  71.     Inc(X1);
  72.     Dec(X2);
  73.     Inc(Y1);
  74.     Dec(Y2);
  75.   End;
  76.   SetColor(OldClr);
  77. End;
  78.  
  79. Procedure ShadeText(X,Y:Word;T:String);
  80.  
  81. { ╔════════════════════════════════════════════════════════════════════════╗ }
  82. { ║  Displays the text at X,Y with a shadow.                               ║ }
  83. { ╚════════════════════════════════════════════════════════════════════════╝ }
  84.  
  85. Var
  86.   OldClr :Word;
  87.  
  88. Begin
  89.   OldClr:=GetColor;
  90.   SetColor(GetBkColor);
  91.   OutTextXY(X, Y, T);
  92.   SetColor(OldClr);
  93.   OutTextXY(X+2, Y+2, T);
  94. End;
  95.  
  96. Procedure GraphicSpace(X,Y,Spot:Word);
  97.  
  98. { ╔════════════════════════════════════════════════════════════════════════╗ }
  99. { ║   Displays a space character 'Spot' number of characters from    X,Y.  ║ }
  100. { ╚════════════════════════════════════════════════════════════════════════╝ }
  101.  
  102. Begin
  103.   SetFillStyle(SolidFill,GetBkColor);
  104.   Bar(X+(Spot*TextWidth(' ')),Y,X+(Spot*TextWidth(' '))+TextWidth(' '),Y+TextWidth(' '));
  105. End;
  106.  
  107. Procedure TwirlyCursor(X,Y,Spot:Word;Frame:Byte);
  108.  
  109. { ╔════════════════════════════════════════════════════════════════════════╗ }
  110. { ║   Draws the animated cursor at X,Y using frame number Frame.           ║ }
  111. { ╚════════════════════════════════════════════════════════════════════════╝ }
  112.  
  113. Var
  114.   CharSize:Word;
  115.  
  116. Begin
  117.   CharSize:=TextWidth(' ');
  118.   GraphicSpace(X,Y,Spot);
  119.   Case Frame Of
  120.       1:OutTextXY(X+(Spot*CharSize),Y,'-');
  121.       2:OutTextXY(X+(Spot*CharSize),Y,'/');
  122.       3:OutTextXY(X+(Spot*CharSize),Y,'|');
  123.       4:OutTextXY(X+(Spot*CharSize),Y,'\');
  124.       5:OutTextXY(X+(Spot*CharSize),Y,'-');
  125.       6:OutTextXY(X+(Spot*CharSize),Y,'/');
  126.       7:OutTextXY(X+(Spot*CharSize),Y,'|');
  127.       8:OutTextXY(X+(Spot*CharSize),Y,'\');
  128.   End;
  129. End;
  130.  
  131. Procedure LineCursor(X,Y,Spot:Word;OnOff:Boolean);
  132.  
  133. Var
  134.   Width,
  135.   OldClr   :Word;
  136.  
  137. Begin
  138.   OldClr:=GetColor;
  139.   If Not OnOff Then SetColor(GetBkColor);
  140.   Width:=X+Spot*TextWidth(' ')-1;
  141.   Line(Width,Y,Width,Y+TextHeight(' ')-2);
  142.   SetColor(OldClr);
  143. End;
  144.  
  145. Procedure CommentWindow(X,Y:Word;Comment:String);
  146.  
  147. Const
  148.   Head    = 'Comment';
  149.  
  150. Var
  151.   CWind   :GraphicWindow;
  152.   Dummy   :Byte;
  153.   NewY,
  154.   Width   :Word;
  155.   Done,
  156.   Held,
  157.   Doubled,
  158.   Special :Boolean;
  159.   Key     :Char;
  160.  
  161. Begin
  162.   Width:=TextWidth(Comment)+20;
  163.   If Width<TextWidth(Head)+20 Then
  164.     Width:=TextWidth(Head)+20;
  165.   CWind.Open(X,Y,X+Width,Y+52+3*TextHeight(Head),Yellow,Black,3,SolidFill,Black,True);
  166.   CWind.NewHeading(Head,CentreText,White,CloseDotFill,Blue);
  167.   CWind.CloseIcon(True);
  168.   CWind.HeadingIcon(True);
  169.   Mouse.Hide;
  170.   OutTextXY(X+10,Y+20+TextHeight(Head),Comment);
  171.   Mouse.Show;
  172.   Width:=(Width Div 2)-(TextWidth('Okay') Div 2);
  173.   NewY :=Y+30+2*TextHeight(Head);
  174.   CWind.Buttons.Create(X+Width,NewY,X+10+Width+TextWidth('Okay'),NewY+10+TextHeight('Okay'),
  175.                        2, Black, NIL, 'Okay', False, #13);
  176.   Done:=False;
  177.   Repeat
  178.     CWind.Buttons.WaitForClick(X, Y, Dummy, Held, Doubled, Special, Key);
  179.     If (Key=KeyCode(Key_Ctrl, Key_F5)) And
  180.        Held Then CWind.Drag;
  181.     Done:=CWind.CloseButtonNum=CWind.Buttons.Number;
  182.     Done:=Done Or ((Special=False) And (Key=#13));
  183.   Until Done;
  184.   CWind.Close;
  185. End;
  186.  
  187. Procedure EditString(X,Y:Word;MaxLets:Byte;Upper:Boolean;Var MainStr:String);
  188.  
  189. { ╔════════════════════════════════════════════════════════════════════════╗ }
  190. { ║   This will get a string at X,Y.  It destroys what is on the screen.   ║ }
  191. { ╚════════════════════════════════════════════════════════════════════════╝ }
  192.  
  193. Var
  194.   Ins             :Boolean;   {Boolean for the Insert Key Status}
  195.   C               :Char;      {Current Character}
  196.   Count,                      {Number Of Chars In String}
  197.   CurXPos         :Byte;      {Current X Position of Cursor}
  198.   FlashCount      :LongInt;
  199.   OldClr          :Word;
  200.   OnOff           :Boolean;
  201.  
  202. Begin
  203.   Mouse.Hide;
  204.   Ins:=False;                {The Insert key has not yet been pressed}
  205.   CurXPos:=1;                {Current Relative X Position+1}
  206.   UnPadVar(MainStr,MainStr);
  207.   If Length(MainStr)>MaxLets Then
  208.     MainStr:=Copy(MainStr,1,MaxLets);
  209.   SetFillStyle(EmptyFill,GetColor);
  210.   Bar(X,Y,X+TextWidth(MainStr),Y+TextHeight(MainStr));
  211.   OutTextXY(X,Y,MainStr);
  212.   Count:=Length(MainStr)+1;  {How many letters in the string+1}
  213.   FlashCount:=0;
  214.   OnOff:=True;
  215.   OldClr:=GetColor;
  216.  
  217.   Repeat                     {Repeat Until [Return] is Pressed}
  218.     If Ins Then SetColor(LightRed) Else SetColor(LightGreen);
  219.     While Not KeyPressed do
  220.     Begin
  221.       Inc(FlashCount);
  222.       If FlashCount>Mouse.ComputerSpeed Then
  223.       Begin
  224.         LineCursor(X,Y,CurXPos-1,OnOff);
  225.         OnOff:=Not OnOff;
  226.         FlashCount:=0;
  227.       End;
  228.     End;
  229.     LineCursor(X,Y,CurXPos-1,False);
  230.     SetColor(OldClr);
  231.     If Upper Then
  232.       C:=UpCase(ReadKey)
  233.     Else
  234.       C:=ReadKey;
  235.  
  236.     If C=Chr(0) Then         {Check for a cursor key}
  237.     Begin
  238.       C:=ReadKey;            {Which cursor key}         {Numeric Keypad Value}
  239.       If (C='O') Then CurXPos:=Count;                            {1}
  240.       If (C='P') And (CurXPos>=3) Then Dec(CurXPos,2);           {2}
  241.       If (C='Q') And (CurXPos>=4) Then Dec(CurXPos,3);           {3}
  242.       If (C='K') And (CurXPos>1) Then Dec(CurXPos);              {4}
  243.       If (C='M') And (CurXPos<Count) Then Inc(CurXPos);          {6}
  244.       If (C='G') Then CurXPos:=1;                                {7}
  245.       If (C='H') And (CurXPos<=Count-2) Then Inc(CurXPos,2);     {8}
  246.       If (C='I') And (CurXPos<=Count-3) Then Inc(CurXPos,3);     {9}
  247.       If (C=#7 ) Then MainStr[0]:=Chr(CurXPos-1);                {Shift-Del}
  248.       If (C='S') And (Count>1) Then                              {Del}
  249.       Begin
  250.         Bar(X,Y,X+TextWidth(MainStr),Y+TextHeight(MainStr));
  251.         Delete(MainStr,CurXPos,1);
  252.         OutTextXY(X,Y,MainStr);
  253.         Dec(Count);
  254.       End;
  255.       If (C='R') Then                                            {Ins}
  256.         Ins:=Not Ins;
  257.